home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOSPRO6.DMS / in.adf / Wonderland / Wonderland.AMOS / Wonderland.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1992-09-29  |  15.1 KB  |  753 lines
  1. 'Dithell's Wonderland  
  2. Set Buffer 10
  3. Amos Lock 
  4. Close Editor 
  5. A3000=0
  6. Timer=0
  7. For L=0 To 20000
  8. Next L
  9. If Timer<28 Then A3000=1
  10. Led Off 
  11. If Length(5)=0
  12.    Load "AMOSPro_Productivity2:Wonderland/Wonderland_Samples.Abk"
  13. End If 
  14. Sam Bank 5
  15. Sam Loop Off 
  16. Key Speed 10,2
  17. BGON=1
  18. Dim SCR(61,28),C(15)
  19. Dim X(11),Y(11),XS(11),YS(11),MY(11),F(11),ALT(11)
  20. Dim FX(4),FY(4),FXS(4),FYS(4),DX(4),DY(4),FF(4)
  21. Dim RBOWSEED(5)
  22. For L=1 To 5
  23.    RBOWSEED(L)=Peek(Start(4)+7200+L)
  24. Next L
  25. Dim CHAN(6)
  26. CHAN(1)=1 : CHAN(2)=2 : CHAN(3)=4 : CHAN(4)=12 : CHAN(5)=12 : CHAN(6)=12
  27. Dim TN(3)
  28. TN(3)=27 : TN(2)=26 : TN(1)=10 : TN(0)=10
  29. Dim GWALK(3)
  30. GWALK(0)=69 : GWALK(1)=70 : GWALK(2)=69 : GWALK(3)=71
  31. Dim FSC(4)
  32. FSC(0)=100 : FSC(1)=300 : FSC(2)=500 : FSC(3)=700
  33. '
  34. For L=0 To 14
  35.    Read M
  36.    If M Then Make Mask L+1 : Else No Mask L+1
  37. Next L
  38. Data 1,0,1,1,0,1,1,0,1,0,0,0,0,0,0
  39. '
  40. For L=16 To 73
  41.    If L=26 Then L=28
  42.    Make Mask L
  43. Next L
  44. No Mask 26
  45. No Mask 27
  46. No Mask 74
  47. No Mask 75
  48. '
  49. TITLE:
  50. Sprite Off 
  51. Wait Vbl 
  52. Set Rainbow 1,14,232,"","",""
  53. Rainbow 1,0,0,0
  54. Load Iff "AMOSPro_Productivity2:Wonderland/Title_Screen.Iff",0
  55. Curs Off 
  56. Hide On 
  57. Bob Off 
  58. Clear Key 
  59. GAME=0
  60. P=0
  61. If BGON=0 Then Bob 1,247,141,75
  62. Bob 0,84,92+P,74
  63. Bob Update On 
  64. Auto View On 
  65. While GAME=0
  66.    If Jup(1) and P>0 Then Gosub AUP
  67.    If Jdown(1) and P<50 Then Gosub ADOWN
  68.    If Fire(1) and P=0 Then GAME=1
  69.    If Fire(1) and P=25 Then GAME=2
  70.    If Fire(1) and P=50 Then Gosub TBCK
  71. Wend 
  72. If GAME=1 Then Gosub GAME
  73. If GAME=2 Then Gosub MAPPER
  74. Goto TITLE
  75. '
  76. GAME:
  77. LEV=1
  78. LI=3
  79. SCOR=0
  80. EXSCOR=0
  81. ELIFE=5000
  82. For L=0 To 31 : Colour 0,0 : Next L
  83. '
  84. SETUPLEV:
  85. Sprite Off 
  86. Gosub SETUPSCRDAT
  87. '
  88. SETSCR:
  89. GOTBLK=0
  90. NBLK=0
  91. Gosub SETUPSCREEN
  92. Screen Offset 0,0,0
  93. Rainbow 1,RSY/2,46,172
  94. Bob Update Off 
  95. Gosub SETRBOW
  96. Gosub SETUPMAP1
  97. Wait Vbl 
  98. Rainbow 1,RSY/2,46,172
  99. Gosub SPRPAL
  100. Autoback 0
  101. X=384 : Y=-12 : OX=X : OY=Y : MY=288
  102. MPX=X/16 : MPY=Y/12
  103. XS=0 : YS=0 : MSTP=0 : MI=24
  104. RSX=0 : RSY=168
  105. MXSPD=8 : INERT=1
  106. JUMP=1 : JAV=1 : JSPD=-8
  107. JH=-12
  108. CB=0
  109. HEART=0
  110. MAN=0
  111. GBALL=0
  112. BOUNCE=0
  113. COUNT=0
  114. OK=1
  115. Autoback 0
  116. Screen 0
  117. For L=0 To 3
  118.    Gosub INITFRUIT
  119. Next L
  120. For L=0 To NBAD-1
  121.    On ALT(L) Gosub INITBLOB,INITREDTHING,INITGREENTHING,INITEYE,INITSNAKE
  122.    If ALT(L)=1 or ALT(L)=3 Then Y(L)=Y(L)+8
  123.    If ALT(L)=5 and X(L)>896 Then X(L)=896
  124. Next L
  125. I$=""
  126. Clear Key 
  127. '
  128. MAINLOOP:
  129. '
  130. I$=Lower$(Inkey$)
  131. SCOD=Scancode
  132. Clear Key 
  133. F=0
  134. 'Move Man
  135. If SCOD=69 Then Screen Close 0 : Screen Close 1 : Goto TITLE
  136. If Jleft(1) and XS>-MXSPD and COUNT mod INERT=0 Then Dec XS : F=1 : MI=22
  137. If Jright(1) and XS<MXSPD and COUNT mod INERT=0 Then Inc XS : F=1 : MI=24
  138. If Jup(1) and(JUMP=0 or GBALL>0) and JAV=1 Then JUMP=1 : MY=288 : JAV=0 : YS=-12 : SPL=3 : Gosub SPL : If GBALL>0 Then GBALL=-1
  139. If Jup(1)=0 Then JAV=1
  140. If F=0 and COUNT mod(INERT*3)=0 Then XS=XS-Sgn(XS)
  141. OX=X : OY=Y
  142. If GBALL<1 Then X=X+XS : Y=Y+YS
  143. If X<0 Then X=0 : XS=0
  144. If X>944 Then X=944 : XS=0
  145. If Y<0 Then Y=0 : YS=0
  146. If Y>288 Then Y=288
  147. If Y<MY Then MY=Y
  148. 'Check mans conditions 
  149. SUP=SCR((X+8)/16+1,(Y)/12+1)
  150. SDOWN=SCR((X+8)/16+1,(Y+24)/12+1)
  151. If SDOWN>6 and SDOWN<10 Then INERT=4 : Else INERT=1
  152. SC=Bob Col(1)
  153. If Col(14) and GBALL=0 and Y>BY+4 Then GBALL=1 : Gosub GRAB
  154. If Col(14)=0 Then GBALL=0
  155. If Y=288 Then OK=0
  156. For L=0 To NBAD
  157.    If Col(2+L) Then OK=0
  158. Next L
  159. If OK=0 Then Goto DED
  160. If GBALL>0 Then Gosub DRIFT
  161. '
  162. If SDOWN>0 and YS=>0 and SDOWN<>10 and Y/12*12=>MY-2
  163.    YS=0 : JUMP=0 : JSPD=-2 : Y=Y/12*12 : GBALL=-1 : BOUNCE=0
  164. Else 
  165.    Inc YS : JUMP=1
  166. End If 
  167. If YS<0 and Jup(1)=0 and BOUNCE=0 Then YS=YS/2
  168. If YS>12 Then YS=12
  169. 'Trampoline
  170. If SDOWN=10 and(YS=>0 or GBALL=1) Then YS=-YS+JSPD : Gosub TRAMP : SPL=4 : Gosub SPL : MY=288 : BOUNCE=1 : GBALL=-1 : Sam Play RV,2 : If JSPD>-10 Then Dec JSPD
  171. '
  172. SX=X-144 : SY=Y-64
  173. If SX<0 Then SX=0
  174. If SX>640 Then SX=640
  175. If SY<0 Then SY=0
  176. If SY>168 Then SY=168
  177. '
  178. If INERT=4 and F=1 Then MSTP=(MSTP+1) mod 2 : Else MSTP=(X/16) mod 2
  179. If X=OX Then MSTP=0
  180. If JUMP=1 or GBALL>0 Then MSTP=1
  181. 'CALC CAMERA 
  182. XI=SX-RSX
  183. YI=SY-RSY
  184. If XI<0 Then RSX=RSX+(XI-10)/10
  185. If XI>0 Then RSX=RSX+(XI+10)/10
  186. If YI<0 Then RSY=RSY+(YI-6)/6
  187. If YI>0 Then RSY=RSY+(YI+6)/6
  188. If RSX<0 Then RSX=0
  189. If RSX>640 Then RSX=640
  190. If RSY<0 Then RSY=0
  191. If RSY>120 Then RSY=120
  192. Gosub FRUITS
  193. Bob 1,X,Y,MI+MSTP
  194. If LI>1 Then Sprite 1,192,224,MI+MSTP
  195. If LI>2 Then Sprite 5,216,224,MI+MSTP
  196. '
  197. If NB=1 Then Gosub MOVEBALL
  198. For L=0 To NBAD
  199.    On ALT(L) Gosub MOVEBLOB,MOVEREDTHING,MOVEGREENTHING,MOVEEYE,MOVESNAKE
  200. Next L
  201. '
  202. Rainbow 1,RSY/2,46,172
  203. Screen Offset 0,RSX,RSY
  204. Wait Vbl 
  205. Bob Clear 
  206. If SDOWN>10 and SDOWN<16 and JUMP=0 Then Gosub FILBLK
  207. If TN>0 Then Gosub TNMOVE
  208. Bob Draw 
  209. Screen Swap 
  210. If A3000=1 Then Wait Vbl 
  211. '
  212. Bob Clear 
  213. If SDOWN>10 and SDOWN<16 and JUMP=0 Then Gosub FILBLK : Gosub SCBLK
  214. If TN>0 Then Gosub TNMOVE
  215. Bob Draw 
  216. Screen Swap 
  217. Inc COUNT
  218. If(NBLK>0 and NBLK=GOTBLK) or(I$="c") Then Goto DUNIT
  219. Goto MAINLOOP
  220. '
  221. DED:
  222. Dec LI
  223. SPL=5
  224. Gosub SPL
  225. For L=0 To 50
  226.    Bob 1,X,Y,22+L mod 4
  227.    Bob Update 
  228.    Wait Vbl 
  229. Next L
  230. Bob Off 1
  231. Bob Update 
  232. Wait Vbl 
  233. SPL=6
  234. If LI=0 Then Gosub SPL
  235. Screen 0
  236. Fade 2
  237. Wait 64
  238. Wait Vbl 
  239. Sprite Off 
  240. Rainbow 1,0,0,0
  241. Screen Close 1
  242. Bob Off 
  243. Bob Update 
  244. Wait Vbl 
  245. If LI>0 Then Goto SETSCR
  246. GAMEOVER:
  247. Return 
  248. '
  249. DUNIT:
  250. Screen 0
  251. Wait 25
  252. Sprite Off 
  253. Wait Vbl 
  254. Bob Off 
  255. Bob Update 
  256. Wait Vbl 
  257. Screen Close 0
  258. Screen Close 1
  259. Inc LEV
  260. If LEV=6 Then LEV=1
  261. Goto SETUPLEV
  262. '
  263. SPRPAL:
  264. Screen 0
  265. Get Sprite Palette 
  266. Colour 0,0
  267. For L=0 To 15
  268.    C(L)=Colour(L)
  269.    Colour L+16,C(L)
  270. Next L
  271. Screen 1
  272. For L=0 To 15
  273.    Colour L+16,C(L)
  274. Next L
  275. Colour 30,0
  276. Screen 0
  277. Return 
  278. '
  279. '
  280. SETUPMAP1:
  281. If LEV<1 Then LEV=5
  282. If LEV>5 Then LEV=1
  283. Screen 1
  284. Pen 3 : Paper 0
  285. Locate 36,2 : Print Using "#";LEV
  286. Gosub SCORE
  287. Screen 0
  288. Autoback 0
  289. NB=0 : NBLK=0 : NBAD=0
  290. For L=0 To 11 : ALT(L)=0 : Next L
  291. P=Start(4)+1440*(LEV-1)
  292. For X=1 To 60
  293.    For Y=1 To 24
  294.       If SCR(X,Y)>0 and SCR(X,Y)<11 Then Paste Bob X*16-16,Y*12-12,SCR(X,Y)
  295.       If SCR(X,Y)>10 and SCR(X,Y)<16 Then Inc NBLK : Paste Bob X*16-16,Y*12-12,63
  296.       If SCR(X,Y)>110 Then Paste Bob X*16-16,Y*12-12,SCR(X,Y)-100
  297.       If Peek(P)=16 Then BX=X*16-16 : BY=Y*12-12 : NB=1
  298.       If Peek(P)>16 and Peek(P)<22 and NBAD<11 Then X(NBAD)=X*16-16 : Y(NBAD)=Y*12-12 : ALT(NBAD)=Peek(P)-16 : Inc NBAD
  299.       If SCR(X,Y)>15 and SCR(X,Y)<22 Then SCR(X,Y)=0
  300.       Inc P
  301.    Next Y
  302. Next X
  303. Wait Vbl 
  304. Screen Copy Logic To Physic
  305. Wait Vbl 
  306. Return 
  307. '
  308. SETUPSCRDAT:
  309. P=Start(4)+1440*(LEV-1)
  310. For X=1 To 60
  311.    For Y=1 To 24
  312.       SCR(X,Y)=Peek(P)
  313.       Inc P
  314.    Next Y
  315. Next X
  316. Return 
  317. '
  318. SETUPMAP2:
  319. If LEV<1 Then LEV=5
  320. If LEV>5 Then LEV=1
  321. Screen 1
  322. Pen 3 : Paper 0
  323. Locate 36,2 : Print Using "#";LEV
  324. Screen 0
  325. Autoback 0
  326. Cls 14
  327. P=Start(4)+1440*(LEV-1)
  328. NB=0 : NBAD=0
  329. For X=1 To 60
  330.    For Y=1 To 24
  331.       F=0
  332.       SCR(X,Y)=Peek(P)
  333.       If Peek(P)=16 and NB=1 Then F=1
  334.       If Peek(P)=16 Then NB=1
  335.       If Peek(P)>16 and NBAD>11 Then F=1
  336.       If Peek(P)>16 Then Inc NBAD
  337.       If F=0 and Peek(P)>0 and Peek(P)<22 Then Paste Bob X*16-16,Y*12-12,Peek(P)
  338.       Inc P
  339.    Next Y
  340. Next X
  341. If NBAD>12 Then NBAD=12
  342. Rainbow 1,0,46,148
  343. Screen Copy Logic To Physic
  344. Wait Vbl 
  345. Gosub SPRPAL
  346. Autoback 1
  347. Clear Key 
  348. Return 
  349. '
  350. SETUPSCREEN:
  351. Auto View Off 
  352. If BGON=1 and GAME=1 Then Load Iff "AMOSPro_Productivity2:Wonderland/Landscape.Iff",0
  353. If BGON=0 or GAME=2 Then Screen Open 0,960,288,16,Lowres : Curs Off : Cls 14
  354. Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  355. Curs Off 
  356. Wait Vbl 
  357. Double Buffer 
  358. If GAME=1 Then Load Iff "AMOSPro_Productivity2:Wonderland/Score_Panel.Iff",1 : Screen Display 0,128,48,320,168 : Screen Display 1,128,218,320,32
  359. If GAME=2 Then Load Iff "AMOSPro_Productivity2:Wonderland/Editor_Panel.Iff",1 : Screen Display 0,128,48,320,144 : Screen Display 1,128,194,320,32
  360. Screen 1 : Paper 0 : Pen 3
  361. Screen 0 : Curs Off : Flash Off 
  362. Auto View On 
  363. Return 
  364. '
  365. MAPPER:
  366. LEV=1
  367. CS=1
  368. Gosub SETUPSCREEN
  369. Gosub SETRBOW
  370. Gosub SETUPMAP2
  371. Screen 1
  372. Reserve Zone 5
  373. Set Zone 1,7,7 To 56,24
  374. Set Zone 2,71,7 To 120,24
  375. Set Zone 3,135,7 To 184,24
  376. Set Zone 4,199,7 To 240,24
  377. Set Zone 5,247,7 To 264,24
  378. Limit Mouse 128,48 To 448,220
  379. Show On 
  380. MK=-1
  381. MXS=21
  382. I$="" : Clear Key 
  383. Repeat 
  384.    I$=Lower$(Inkey$)
  385.    SCOD=Scancode
  386.    Clear Key 
  387.    MC=Mouse Click
  388.    Z=Zone(1,X Mouse-128,Y Mouse-194)
  389.    If MC=1 and Z=1 Then I$="l"
  390.    If MC=1 and Z=2 Then I$="s"
  391.    If MC=1 and Z=3 Then I$="c"
  392.    If MC=1 and Z=4 Then SCOD=69
  393.    If SCOD=76 Then Gosub CSCR : Gosub PMAP : Inc LEV : Gosub SETRBOW : Gosub SETUPMAP2 : Show On 
  394.    If SCOD=77 Then Gosub CSCR : Gosub PMAP : Dec LEV : Gosub SETRBOW : Gosub SETUPMAP2 : Show On 
  395.    If I$="l" Then Gosub CSCR : Gosub LD : Gosub SETUPMAP2 : Show On 
  396.    If I$="s" Then Gosub CSCR : Gosub PMAP : Gosub SV : Gosub SETUPMAP2 : Show On 
  397.    If I$="c" Then Gosub CSCR : Gosub CLRMAP : Cls 14 : Gosub SPRPAL : Show On 
  398.    If I$=" " Then RBOWSEED(LEV)=(RBOWSEED(LEV)+3) mod 64 : Hide On : Gosub SETRBOW : Show On 
  399.    Wait Vbl 
  400.    Sprite 1,376,203,CS
  401.    MK=Mouse Key
  402.    SX=X Mouse
  403.    SY=Y Mouse
  404.    Rainbow 1,(Min(SY,192)-48)/2,46,148
  405.    Screen Offset 0,(SX-128)*2,Min(SY-48,144)
  406.    If SX=448 Then SX=447
  407.    Screen 1
  408.    X=(SX-128)/5.33+1
  409.    Y=(SY-48)/6+1
  410.    If SCOD=78 Then Inc CS
  411.    If SCOD=79 Then Dec CS
  412.    If MC>0 and(Y>25 and X<7) Then Dec CS
  413.    If MC>0 and(Y>25 and X>9 and X<15) Then Inc CS
  414.    If CS<1 Then CS=MXS
  415.    If CS>MXS Then CS=1
  416.    If Y<25 and MK=1 Then B=CS : Gosub CHANGEBLK
  417.    If Y<25 and MK=2 Then B=0 : Gosub CHANGEBLK
  418. Until SCOD=69
  419. Gosub CSCR
  420. Gosub PMAP
  421. Screen Close 0
  422. Screen Close 1
  423. Return 
  424. '
  425. LD:
  426. M$="Select a .lev file to LOAD"
  427. Gosub FILESEL
  428. Bload F$,Start(4)
  429. For L=1 To 5
  430.    RBOWSEED(L)=Peek(Start(4)+7200+L)
  431. Next L
  432. Return 
  433. '
  434. SV:
  435. M$="SAVE levels as..."
  436. Gosub FILESEL
  437. Bsave F$,Start(4) To Start(4)+7205
  438. Return 
  439. '
  440. PMAP:
  441. If LEV<1 Then LEV=5
  442. If LEV>5 Then LEV=1
  443. P=Start(4)+1440*(LEV-1)
  444. NB=0 : NBLK=0
  445. For X=1 To 60
  446.    For Y=1 To 24
  447.       Poke P,SCR(X,Y)
  448.       Inc P
  449.    Next Y
  450. Next X
  451. Return 
  452. '
  453. CSCR:
  454. Screen 0
  455. Sprite Off 1
  456. Hide On 
  457. Rainbow 1,0,0,0
  458. Cls 0
  459. Wait Vbl 
  460. Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  461. Screen Swap 
  462. Return 
  463. '
  464. '
  465. CHANGEBLK:
  466. Screen 0
  467. OS=SCR(X,Y)
  468. If OS=16 Then NB=0
  469. If OS>16 and NBAD>0 Then Dec NBAD
  470. '
  471. If B>16 and B<>20 and(SCR(X,Y+1)=0 or Y=1) Then Return 
  472. If B>16 and NBAD>11 Then Return 
  473. If B=21 and(X>57 or X<2) Then Return 
  474. If B=16 and NB=1 Then Return 
  475. '
  476. Ink 14 : Bar X*16-16,Y*12-12 To X*16-1,Y*12-1
  477. If B>0 Then Paste Bob X*16-16,Y*12-12,B
  478. SCR(X,Y)=B
  479. If B=16 Then NB=1
  480. If B>16 Then Inc NBAD
  481. Return 
  482. '
  483. '
  484. CLRMAP:
  485. For X=1 To 60
  486.    For Y=1 To 24
  487.       SCR(X,Y)=0
  488.    Next Y
  489. Next X
  490. Clear Key 
  491. NB=0 : NBLK=0 : NBAD=0
  492. For L=0 To 11 : ALT(L)=0 : Next L
  493. Return 
  494. '
  495. MOVEBALL:
  496. If GBALL=1 Then BY=BY+2
  497. If GBALL<>1 and BY>0 and SCR(BX/16+1,BY/12+1)=0 Then Dec BY
  498. Bob 14,BX,BY,28
  499. Return 
  500. '
  501. FILBLK:
  502. SCR((X+8)/16+1,(Y+24)/12+1)=SDOWN+100
  503. PX=(X+8)/16*16
  504. PY=(Y+24)/12*12
  505. Paste Bob PX,PY,SDOWN
  506. Return 
  507. '
  508. SCBLK:
  509. SPL=1
  510. Gosub SPL
  511. SCOR=SCOR+(SDOWN-10)*10
  512. EXSCOR=EXSCOR+(SDOWN-10)*10
  513. Gosub SCORE
  514. Inc GOTBLK
  515. Return 
  516. '
  517. GRAB:
  518. JAV=1
  519. XS=0 : YS=0
  520. X=X Bob(14)
  521. Y=Y Bob(14)+20
  522. Return 
  523. '
  524. DRIFT:
  525. X=X Bob(14)
  526. Y=Y Bob(14)+20
  527. Return 
  528. '
  529. TRAMP:
  530. TNX=(X+8)/16*16
  531. TNY=(Y+24)/12*12
  532. TN=8
  533. Return 
  534. '
  535. TNMOVE:
  536. Dec TN
  537. Paste Bob TNX,TNY,TN(TN/2)
  538. Return 
  539. '
  540. '
  541. MOVEBLOB:
  542. If F(L)>0 Then Dec F(L) : I=38-Abs(F(L)-3) : Goto NOM
  543. Y(L)=Y(L)+YS(L)
  544. If Y(L)=<MY(L) Then MY(L)=Y(L)
  545. X(L)=X(L)+XS(L)
  546. If X(L)<0 Then X(L)=0
  547. If X(L)>944 Then X(L)=944
  548. If Y(L)<0 Then Y(L)=0 : YS(L)=0 : XS(L)=0
  549. If Y(L)>288 Then Y(L)=288
  550. S=SCR((X(L)+8)/16+1,(Y(L)+4)/12+1)
  551. If F(L)=0 and(Y(L)+4)/12*12-4=>MY(L)-2 and(S>0 and YS(L)>0) or Y(L)=288 Then Y(L)=(Y(L)+4)/12*12-4 : Gosub INITBLOB
  552. I=34
  553. If YS(L)<10 Then Inc YS(L)
  554. NOM:
  555. If X(L)<RSX-16 or X(L)>RSX+320 or Y(L)>RSY+168 or Y(L)<RSY-16 Then Bob Off L+2 : Return 
  556. Bob L+2,X(L),Y(L)-12,I
  557. Return 
  558. '
  559. INITBLOB:
  560. XS(L)=Rnd(6)-3
  561. YS(L)=-6-Rnd(10)
  562. F(L)=7
  563. MY(L)=288
  564. Return 
  565. '
  566. MOVEREDTHING:
  567. S1=SCR((X(L)-8)/16+1,(Y(L)/12+2))
  568. S2=SCR((X(L)+20)/16+1,(Y(L)/12+2))
  569. If S1=0 or X(L)=0 Then XS(L)=4
  570. If S2=0 or X(L)=948 Then XS(L)=-4
  571. X(L)=X(L)+XS(L)
  572. If X(L)<RSX-16 or X(L)>RSX+320 or Y(L)>RSY+168 or Y(L)<RSY-32 Then Bob Off L+2 : Return 
  573. Bob L+2,X(L),Y(L)+2,39+(COUNT/2) mod 6
  574. Return 
  575. INITREDTHING:
  576. XS(L)=-4
  577. Return 
  578. '
  579. MOVEGREENTHING:
  580. If F(L)=2 and Rnd(6)>0 Then Bob L+2,X(L),Y(L)-8,72 : Return 
  581. If F(L)=2 Then F(L)=0
  582. Y(L)=Y(L)+YS(L)
  583. If Y(L)<MY(L) Then MY(L)=Y(L)
  584. O=X(L)
  585. I=0
  586. X(L)=X(L)+XS(L)
  587. If X(L)<0 Then X(L)=0 : XS(L)=-XS(L)
  588. If X(L)>944 Then X(L)=944 : XS(L)=-XS(L)
  589. If Y(L)<0 Then Y(L)=0 : YS(L)=0 : XS(L)=0
  590. If Y(L)>288 Then Y(L)=288
  591. S=SCR((X(L)+8+XS(L)*4)/16+1,(Y(L)+4)/12+1)
  592. If F(L)=0 and(Y(L)+4)/12*12-4=>MY(L)-2 and(S>0 and YS(L)>0) or Y(L)=288 Then Y(L)=(Y(L)+4)/12*12-4 : Gosub WGREENTHING
  593. If(S=0 or Rnd(50)=0) and F(L)=1 Then X(L)=O : Gosub JGREENTHING : Bob L+2,X(L),Y(L)-8,72 : Return 
  594. If YS(L)<10 and F(L)=0 Then Inc YS(L)
  595. If X(L)<RSX-16 or X(L)>RSX+320 or Y(L)>RSY+168 or Y(L)<RSY-16 Then Bob Off L+2 : Return 
  596. If F(L)=1 Then I=70+(COUNT+L) mod 2
  597. If F(L)=0 and YS(L)<0 Then I=73
  598. If F(L)=0 and YS(L)=>0 Then I=69
  599. Bob L+2,X(L),Y(L)-8,I
  600. Return 
  601. '
  602. INITGREENTHING:
  603. Gosub WGREENTHING
  604. Return 
  605. '
  606. JGREENTHING:
  607. F=(Y(L)-Y)/8
  608. If F<1 Then F=1
  609. YS(L)=Max(-16,-4-Rnd(F))
  610. If X(L)>X Then XS(L)=-Rnd(2)-1 : Else XS(L)=Rnd(2)+1
  611. F(L)=2
  612. I=72
  613. MY(L)=288
  614. Return 
  615. WGREENTHING:
  616. If X(L)>X Then XS(L)=-2 : Else XS(L)=2
  617. YS(L)=0
  618. F(L)=1
  619. Return 
  620. '
  621. MOVEEYE:
  622. If COUNT mod 2 Then Goto NOCHASE
  623. If X(L)<X and XS(L)<9 Then Inc XS(L)
  624. If X(L)>X and XS(L)>-9 Then Dec XS(L)
  625. If Y(L)<Y and YS(L)<9 Then Inc YS(L)
  626. If Y(L)>Y and YS(L)>-9 Then Dec YS(L)
  627. NOCHASE:
  628. X(L)=X(L)+XS(L)
  629. Y(L)=Y(L)+YS(L)
  630. If X(L)<RSX-16 or X(L)>RSX+320 or Y(L)>RSY+168 or Y(L)<RSY-16 Then Bob Off L+2 : Return 
  631. Bob L+2,X(L),Y(L),45+COUNT mod 2
  632. Return 
  633. INITEYE:
  634. XS(L)=0 : YS(L)=0
  635. Return 
  636. '
  637. MOVESNAKE:
  638. X(L)=X(L)+XS(L)
  639. S1=SCR((X(L)-8)/16+1,(Y(L)/12+2))
  640. S2=SCR((X(L)+68)/16+1,(Y(L)/12+2))
  641. If S1=0 or X(L)<0 Then XS(L)=4
  642. If S2=0 or X(L)>896 Then XS(L)=-4
  643. If X(L)<0 Then X(L)=0
  644. If X(L)>896 Then X(L)=896
  645. If X(L)<RSX-64 or X(L)>RSX+320 or Y(L)>RSY+168 or Y(L)<RSY-16 Then Bob Off L+2 : Return 
  646. If XS(L)=-4 Then Bob L+2,X(L),Y(L),47+COUNT mod 7
  647. If XS(L)=4 Then Bob L+2,X(L),Y(L),55+COUNT mod 7
  648. Return 
  649. INITSNAKE:
  650. XS(L)=-4
  651. Return 
  652. '
  653. SCORE:
  654. Screen 1
  655. Locate 1,2 : Print Using "######";SCOR
  656. If EXSCOR=>ELIFE and HEART=0 Then L=4 : Gosub INITFRUIT : HEART=1
  657. Screen 0
  658. Return 
  659. '
  660. FRUITS:
  661. For L=0 To 3+HEART
  662.    If FF(L)=>0 Then Gosub MNUM
  663.    If FF(L)<0 Then Gosub MFRUIT
  664. Next L
  665. R=Rnd(200)
  666. If R<5
  667.    DX(R)=Rnd(800)+72
  668.    DY(R)=Rnd(200)+32
  669. End If 
  670. Return 
  671. '
  672. MFRUIT:
  673. If FX(L)>DX(L) and FXS(L)>-10 Then Dec FXS(L)
  674. If FX(L)<DX(L) and FXS(L)<10 Then Inc FXS(L)
  675. If FY(L)>DY(L) and FYS(L)>-10 Then Dec FYS(L)
  676. If FY(L)<DY(L) and FYS(L)<10 Then Inc FYS(L)
  677. FX(L)=FX(L)+FXS(L)
  678. FY(L)=FY(L)+FYS(L)
  679. If Col(15+L) and FF(L)=-2 and FY(L)>-32 Then FF(L)=12 : SCOR=SCOR+FSC(L) : EXSCOR=EXSCOR+FSC(L) : SPL=2 : Gosub SPL : Gosub SCORE
  680. Bob 15+L,FX(L),FY(L),29+L
  681. Return 
  682. '
  683. MNUM:
  684. Dec FF(L)
  685. If L<4 and FF(L)<0 Then Gosub INITFRUIT : Return 
  686. If L=4 and FF(4)<0 Then Gosub EXTRA
  687. FY(L)=FY(L)-2
  688. Bob 15+L,FX(L),FY(L),64+L
  689. Return 
  690. '
  691. INITFRUIT:
  692. FX(L)=Rnd(944)
  693. FY(L)=-200-200*L
  694. DX(L)=Rnd(880)+32
  695. DY(L)=Rnd(240)+32
  696. FXS(L)=0
  697. FYS(L)=0
  698. FF(L)=-2
  699. Return 
  700. '
  701. SPL:
  702. Sam Stop CHAN(SPL)
  703. Sam Play CHAN(SPL),SPL
  704. Return 
  705. '
  706. FILESEL:
  707. Show On 
  708. Repeat 
  709.    F$=Fsel$("AMOSPro_Productivity2:Wonderland/*.lev","",M$)
  710. Until(Len(F$)>4) and(Lower$(Right$(F$,4))=".lev")
  711. Hide On 
  712. Return 
  713. '
  714. SETRBOW:
  715. If LEV<1 Then LEV=5
  716. If LEV>5 Then LEV=1
  717. Set Rainbow 1,14,232,"","",""
  718. R=RBOWSEED(LEV)*64-1
  719. For Y=0 To 231
  720.    Rain(1,Y)=R-Y/15
  721. Next Y
  722. Poke Start(4)+7200+LEV,RBOWSEED(LEV)
  723. Return 
  724. '
  725. EXTRA:
  726. EXSCOR=SCOR mod ELIFE
  727. HEART=0
  728. Bob Off 19
  729. Inc LI
  730. Return 
  731. '
  732. TBCK:
  733. BGON=(BGON+1) mod 2
  734. If BGON=1 Then Bob Off 1 : Else Bob 1,247,141,75
  735. Repeat 
  736. Until Fire(1)=0
  737. Return 
  738. '
  739. ADOWN:
  740. For L=0 To 24
  741.    Inc P
  742.    Bob 0,84,92+P,74
  743.    Wait Vbl 
  744. Next L
  745. Return 
  746. '
  747. AUP:
  748. For L=0 To 24
  749.    Dec P
  750.    Bob 0,84,92+P,74
  751.    Wait Vbl 
  752. Next L
  753. Return